
{***********************************************************}
{                                                           }
{      Informix Data Access Components                      }
{                                                           }
{      TIfxSQL component                                    }
{                                                           }
{      Copyright (c) 2001-2008 Luxena Software Company      }
{      http://www.luxena.com                                }
{      e-mail: support@luxena.com                           }
{                                                           }
{***********************************************************}

unit IfxSQL;

{$I lx.inc}

interface

uses
  Classes, DB, LXClasses, LXDBTypes, LXMacroSQL, IfxTypes, IfxSqlHdr, IfxSqlda,
  IfxDecimal, IfxDateTime, IfxLocator, IfxInt8, IfxConnection, IfxSQLProcessor,
  IfxLob, IfxValues;


const

{ Property Default Values }

  IFX_DEFAULT_CACHE_HANDLE = True;
  IFX_DEFAULT_PARAM_CHECK = True;


type

{ TIfxSQLVAR }

  TIfxSQLDA = class;

  TIfxSQLVAR = class(TLXUnknownStub, IIfxValue, IIfxValueBufferProvider)
  private
    FOwner: TIfxSQLDA;
    FIndex: Integer;
    FData: PIfx_sqlvar;
    FIsNull: int2;
    FValue: TIfxFieldValue;
    FModified: Boolean;

    function GetDataType: Integer;
    procedure SetDataType(Value: Integer);
    function GetSize: Integer;
    procedure SetSize(Value: Integer);
    function GetExtendedType: Integer;
    procedure SetExtendedType(Value: Integer);
    function GetPrecision: Integer;
    function GetScale: Integer;
    function GetIsBlob: Boolean;
    function GetTypeName: string;

    function DataReadBuffer: PChar;
    function DataWriteBuffer: PChar;
    procedure Validate(Buffer: Pointer);
    function ResetSubject: TLXDelegat;
    function GetBufferSize: Integer;

    function GetIsNull: Boolean;
    function ActiveValue: TIfxValue;
    function GetAsBCD: TBcd;
    function GetAsBoolean: Boolean;
    function GetAsByte: TBlobByteData;
    function GetAsCurrency: Currency;
    function GetAsDate: int4;
    function GetAsDateTime: TDateTime;
    function GetAsDecimal: TDecimal;
    function GetAsDTime: TDTime;
    function GetAsFloat: Double;
    function GetAsInt8: TIfx_int8;
    function GetAsInteger: Integer;
    function GetAsInterval: Intrvl;
    function GetAsLargeint: Largeint;
    function GetAsLob: IIfxLob;
    function GetAsLocator: PLoc;
    function GetAsSmallFloat: Single;
    function GetAsSmallInt: int2;
    function GetAsSQLTimeStamp: TSQLTimeStamp;
    function GetAsString: string;
    function GetAsTime: TDateTime;
    function GetAsVariant: Variant;

    procedure SetNull;
    procedure SetIsNull(Value: Boolean);
    procedure SetTypedValue(sqltype: int2; sqllen: int4; sqlxid: int4; FieldValue: TIfxFieldValue);
    procedure SetTypedString(sqltype: int2; const Value: string; FieldValue: TIfxStringValue);
    procedure SetTypedLocator(sqltype: int2; Size: Integer; Data: Pointer);
    procedure SetTypedLob(sqlxid: int4; const Value: IIfxLob; FieldValue: TIfxLobValue);
    procedure SetAsBCD(const Value: TBcd);
    procedure SetAsBlob(const Value: IIfxLob);
    procedure SetAsBoolean(Value: Boolean);
    procedure SetAsByte(const Value: TBlobByteData);
    procedure SetAsChar(const Value: string);
    procedure SetAsClob(const Value: IIfxLob);
    procedure SetAsCurrency(Value: Currency);
    procedure SetAsDate(Value: int4);
    procedure SetAsDateTime(Value: TDateTime);
    procedure SetAsDecimal(const Value: TDecimal);
    procedure SetAsDTime(const Value: TDTime);
    procedure SetAsFloat(Value: Double);
    procedure SetAsInt8(const Value: TIfx_int8);
    procedure SetAsInteger(Value: int4);
    procedure SetAsInterval(const Value: TIntrvl);
    procedure SetAsLargeint(Value: Largeint);
    procedure SetAsLocator(Value: PLoc);
    procedure SetAsLVarChar(const Value: string);
    procedure SetAsMoney(const Value: TDecimal);
    procedure SetAsNChar(const Value: string);
    procedure SetAsNVarChar(const Value: string);
    procedure SetAsOpaque(const Value: string);
    procedure SetAsSmallFloat(Value: Single);
    procedure SetAsSmallInt(Value: int2);
    procedure SetAsSQLTimeStamp(const Value: TSQLTimeStamp);
    procedure SetAsText(const Value: string);
    procedure SetAsTime(Value: TDateTime);
    procedure SetAsVarChar(const Value: string);
    procedure SetAsVariant(const Value: Variant);

    function GetLobBufferStrategy: TIfxLobBufferStrategy;

  protected
    function GetName: string; virtual; abstract;
    procedure SetName(const Value: string); virtual; abstract;

    procedure AllocateBuffer;
    procedure FreeBuffer;

    procedure SetBlobType(BlobType: TBlobType);

  public
    constructor Create(Data: PIfx_sqlvar);
    destructor Destroy; override;

    property Owner: TIfxSQLDA read FOwner;
    property Index: Integer read FIndex;
    property Name: string read GetName write SetName;

    property Data: PIfx_sqlvar read FData;
    
    procedure Clear;

    property DataType: Integer read GetDataType write SetDataType;
    property Size: Integer read GetSize write SetSize;
    property ExtendedType: Integer read GetExtendedType write SetExtendedType;
    property Precision: Integer read GetPrecision;
    property Scale: Integer read GetScale;
    property IsBlob: Boolean read GetIsBlob;
    property TypeName: string read GetTypeName;

    property Buffer: PChar read DataReadBuffer;
    property BufferSize: Integer read GetBufferSize;

    property IsNull: Boolean read GetIsNull write SetIsNull;
    property AsBCD: TBcd read GetAsBCD write SetAsBCD;
    property AsBlob: IIfxLob read GetAsLob write SetAsBlob;
    property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
    property AsByte: TBlobByteData read GetAsByte write SetAsByte;
    property AsChar: string read GetAsString write SetAsChar;
    property AsClob: IIfxLob read GetAsLob write SetAsClob;
    property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
    property AsDate: int4 read GetAsDate write SetAsDate;
    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
    property AsDecimal: TDecimal read GetAsDecimal write SetAsDecimal;
    property AsDTime: TDTime read GetAsDTime write SetAsDTime;
    property AsFloat: Double read GetAsFloat write SetAsFloat;
    property AsInt8: TIfx_int8 read GetAsInt8 write SetAsInt8;
    property AsInteger: int4 read GetAsInteger write SetAsInteger;
    property AsInterval: TIntrvl read GetAsInterval write SetAsInterval;
    property AsLargeint: Largeint read GetAsLargeint write SetAsLargeint;
    property AsLob: IIfxLob read GetAsLob;
    property AsLocator: PLoc read GetAsLocator write SetAsLocator;
    property AsLVarChar: string read GetAsString write SetAsLVarChar;
    property AsMoney: TDecimal read GetAsDecimal write SetAsMoney;
    property AsNChar: string read GetAsString write SetAsNChar;
    property AsNVarChar: string read GetAsString write SetAsNVarChar;
    property AsOpaque: string read GetAsString write SetAsOpaque;
    property AsSmallFloat: Single read GetAsSmallFloat write SetAsSmallFloat;
    property AsSmallInt: int2 read GetAsSmallInt write SetAsSmallInt;
    property AsSQLTimeStamp: TSQLTimeStamp read GetAsSQLTimeStamp write SetAsSQLTimeStamp;
    property AsString: string read GetAsString write SetAsChar;
    property AsText: string read GetAsString write SetAsText;
    property AsTime: TDateTime read GetAsTime write SetAsTime;
    property AsVarChar: string read GetAsString write SetAsVarChar;
    property AsVariant: Variant read GetAsVariant write SetAsVariant;
    property Value: Variant read GetAsVariant write SetAsVariant;

    function Format(const FmtStr: string): string;

    procedure SaveToStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
    procedure LoadFromStream(Stream: TStream; BlobType: TBlobType);
    procedure LoadFromFile(const FileName: string; BlobType: TBlobType);

    procedure AssignValue(const Value: IIfxValue);
    procedure AssignParam(Param: TParam);
    procedure AssignField(Field: TField);

    procedure AssignToValue(const Value: IIfxValue);
    procedure AssignToParam(Param: TParam);
    procedure AssignToField(Field: TField);

    property Modified: Boolean read FModified write FModified;
  end;


{ TIfxSQLDA }

  TIfxSQLDA = class
  private
    FSQLDA: PIfx_SQLDA;
    FSQLVARs: TList;
    FLobBufferStrategy: TIfxLobBufferStrategy;

    function GetCount: Integer;
    function GetItem(Index: Integer): TIfxSQLVAR;
    function GetModified: Boolean;
    procedure SetModified(Value: Boolean);

  protected
    procedure AllocateBuffers;
    procedure FreeBuffers;

    procedure FreeSQLDA; virtual; abstract;

    function ResetSubject: TLXDelegat; virtual; abstract;

  public
    constructor Create;
    destructor Destroy; override;

    function IndexOf(Item: TIfxSQLVAR): Integer;
    function FindSQLVAR(const Name: string): TIfxSQLVAR;
    function SQLVARByName(const Name: string): TIfxSQLVAR;

    procedure AssignValues(Source: TIfxSQLDA); overload;
    procedure AssignValues(Source: TParams); overload;
    procedure AssignValues(Source: TFields); overload;

    procedure Clear;
    
    property SQLDA: PIfx_SQLDA read FSQLDA;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TIfxSQLVAR read GetItem; default;

    property Modified: Boolean read GetModified write SetModified;

    property LobBufferStrategy: TIfxLobBufferStrategy read FLobBufferStrategy write FLobBufferStrategy;
  end;


{ TIfxParam }

  TIfxParam = class(TIfxSQLVAR)
  private
    FName: string;

  protected
    function GetName: string; override;
    procedure SetName(const Value: string); override;

  public
    constructor Create(Data: PIfx_sqlvar);
  end;


{ TIfxParams }

  TIfxParams = class(TIfxSQLDA)
  private
    function GetItem(Index: Integer): TIfxParam;

  protected
    procedure FreeSQLDA; override;

    function ResetSubject: TLXDelegat; override;

  public
    procedure Reset(Count: Integer);

    function FindParam(const Name: string): TIfxParam;
    function ParamByName(const Name: string): TIfxParam;

    procedure Assign(Source: TIfxSQLDA); overload;
    procedure Assign(Source: TParams); overload;
    procedure Assign(Source: TFields); overload;

    property Items[Index: Integer]: TIfxParam read GetItem; default;
  end;


{ TIfxField }

  TIfxField = class(TIfxSQLVAR)
  protected
    function GetName: string; override;
    procedure SetName(const Value: string); override;

  public
    constructor Create(Data: PIfx_sqlvar);
    class procedure AdjustType(var sqltype: int2; var sqllen, sqlxid: int4;
      OnlyInfo: Boolean);
  end;


{ TIfxFields }

  TIfxFields = class(TIfxSQLDA)
  private
    FBufferResetSubject: TLXDelegat;

    function GetItem(Index: Integer): TIfxField;
    function GetRecordSize: Integer;

  protected
    procedure FreeSQLDA; override;

    function ResetSubject: TLXDelegat; override;

  public
    constructor Create;
    destructor Destroy; override;

    procedure Reset(SQLDA: PIfx_SQLDA);

    function FindField(const Name: string): TIfxField;
    function FieldByName(const Name: string): TIfxField;

    property Items[Index: Integer]: TIfxField read GetItem; default;
    property RecordSize: Integer read GetRecordSize;
  end;


{ TIfxCustomSQL }

  TIfxCustomSQL = class(TIfxConnectionClient)
  private
    FSQL: TStrings;
    FSQLProcessor: TIfxSQLProcessor;
    FMacroSQLElement: TLXMacroSQLElement;
    FMacros: TStrings;
    FParamCheck: Boolean;
    FText: string;

    FCacheHandle: Boolean;
    FScrollable: Boolean;
    FResource: TIfxStatementResource;
    FLobBufferStrategy: TIfxLobBufferStrategy;
    FParams: TIfxParams;
    FSourceParams: TParams;
    FCursor: PIfx_Cursor;
    FFields: TIfxFields;

    FRowsAffected: int4;
    FBOF: Boolean;
    FEOF: Boolean;

    FOnCloseError: TIfxReleaseErrorEvent;
    FOnUnprepareError: TIfxReleaseErrorEvent;

    procedure SetSQL(Value: TStrings);
    procedure SetSQLProcessor(Value: TIfxSQLProcessor);
    function GetActiveSQLProcessor: TIfxSQLProcessor;
    procedure SetMacros(Value: TStrings);

    procedure SetScrollable(Value: Boolean);

    function GetPrepared: Boolean;
    procedure SetPrepared(Value: Boolean);
    function GetHandle: PIfx_Cursor;
    function GetStmtType: Integer;
    function GetParamCount: Integer;
    function GetCursorName: string;
    function GetFieldCount: Integer;

    procedure MacroSQLChanging(Sender: TObject);
    procedure MacroSQLChanged(Sender: TObject);
    procedure MacrosChanged(Sender: TObject);

    function PrepareMessageProc(const Args: array of const): string;
    function ExecMessageProc(const Args: array of const): string;

  protected
    function ActiveComponentState: TComponentState; virtual;

    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    procedure HandleDatabaseChange; override;

    procedure InternalParseMacroSQL;
    procedure SafeParseMacroSQL;
    procedure SetText(const Value: string);
    procedure BuildText; virtual;

    procedure CheckText;
    procedure CheckPrepared;
    procedure CheckUnprepared;
    procedure CheckOpen;
    procedure CheckClosed;

    procedure InternalPrepare;
    procedure InternalOpen; virtual;
    procedure InternalClose; virtual;
    procedure InternalUnprepare; virtual;

    procedure Fetch(Direction: mint; Distance: Integer);

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure ParseMacroSQL;
    function ExecuteDirect: int4;
    procedure Prepare;
    procedure Unprepare;
    function ParamByName(const ParamName: string): TIfxParam;
    function Execute: int4;
    procedure Open;
    procedure Close;
    function IsCursorOpen: Boolean;
    procedure Next;
    procedure Prior;
    procedure MoveTo(Position: int4);
    procedure MoveBy(Distance: int4);
    function FieldByName(const FieldName: string): TIfxField;

    property SQL: TStrings read FSQL write SetSQL;
    property SQLProcessor: TIfxSQLProcessor read FSQLProcessor write SetSQLProcessor;
    property ActiveSQLProcessor: TIfxSQLProcessor read GetActiveSQLProcessor;
    property Macros: TStrings read FMacros write SetMacros;
    property ParamCheck: Boolean read FParamCheck write FParamCheck default IFX_DEFAULT_PARAM_CHECK;
    property Text: string read FText;
    property CacheHandle: Boolean read FCacheHandle write FCacheHandle default True;
    property Scrollable: Boolean read FScrollable write SetScrollable default False;
    property Prepared: Boolean read GetPrepared write SetPrepared;
    property Handle: PIfx_Cursor read GetHandle;
    property StmtType: Integer read GetStmtType;
    property ParamCount: Integer read GetParamCount;
    property Params: TIfxParams read FParams;
    property SourceParams: TParams read FSourceParams write FSourceParams;
    property CursorName: string read GetCursorName;
    property FieldCount: Integer read GetFieldCount;
    property Fields: TIfxFields read FFields;
    property BOF: Boolean read FBOF;
    property EOF: Boolean read FEOF;
    property RowsAffected: int4 read FRowsAffected;

    property OnCloseError: TIfxReleaseErrorEvent read FOnCloseError write FOnCloseError;
    property OnUnprepareError: TIfxReleaseErrorEvent read FOnUnprepareError write FOnUnprepareError;
  end;


{ TIfxSQL }

  TIfxSQL = class(TIfxCustomSQL)
  private
    FToFirstRecord: Boolean;

    function GetVersion: string;
    procedure SetVersion(const Value: string);

    procedure ConnectionStateChange(Sender: TObject; Connecting: Boolean);
    
  protected
    procedure RegisterConnection; override;
    procedure UnregisterConnection; override;
    procedure ConnectionChanging; override;
    procedure ConnectionClosing; override;
    
    procedure InternalOpen; override;
    procedure InternalClose; override;

  public
    constructor Create(AOwner: TComponent); override;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;

  published
    property CacheHandle;
    property Connection;
    property Macros;
    property ParamCheck;
    property Scrollable;
    property SQL;
    property SQLProcessor;
    
    property GoToFirstRecordOnOpen: Boolean read FToFirstRecord write FToFirstRecord default True;
    property Version: string read GetVersion write SetVersion stored False;

    property OnCloseError;
    property OnUnprepareError;
  end;


implementation

uses
  SysUtils, LXTypes, LXConsts, LXSysUtils, LXVariants, LXAppUtils,
  LXDataSetImpl, IfxSqlTypes, IfxVarChar, IfxSqlca, IfxConsts, Ifx, IfxIntf,
  IfxConvert, IfxMonitor, IfxFieldTypes, IfxNativeFields, IfxCustomDataSet;


{ TIfxSQLVAR }

constructor TIfxSQLVAR.Create(Data: PIfx_sqlvar);
begin
  FIndex := -1;
  FData := Data;
  Data^.sqlind := @FIsNull;
  FIsNull := -1;
end;

destructor TIfxSQLVAR.Destroy;
begin
  SetNull;
  inherited;
end;

procedure TIfxSQLVAR.Clear;
begin
  SetNull;
end;

function TIfxSQLVAR.GetDataType: Integer;
begin
  Result := FData^.sqltype;
end;

procedure TIfxSQLVAR.SetDataType(Value: Integer);
begin
  FData^.sqltype := Value;
end;

function TIfxSQLVAR.GetSize: Integer;
begin
  Result := FData^.sqllen;
end;

procedure TIfxSQLVAR.SetSize(Value: Integer);
begin
  FData^.sqllen := Value;
end;

function TIfxSQLVAR.GetExtendedType: Integer;
begin
  Result := FData^.sqlxid;
end;

procedure TIfxSQLVAR.SetExtendedType(Value: Integer);
begin
  FData^.sqlxid := Value;
end;

function TIfxSQLVAR.GetPrecision: Integer;
begin
  Result := PRECTOT(FData^.sqllen);
end;

function TIfxSQLVAR.GetScale: Integer;
begin
  Result := PRECDEC(FData^.sqllen);
end;

function TIfxSQLVAR.GetIsBlob: Boolean;
begin
  Result := TIfxFieldTypes.IsBlobType(FData^.sqltype, FData^.sqlxid);
end;

function TIfxSQLVAR.GetTypeName: string;
begin
  Result := TIfxFieldTypes.GetTypeName(FData^.sqltype, FData^.sqlxid);
end;

function TIfxSQLVAR.DataReadBuffer: PChar;
begin
  Result := FData^.sqldata;
end;

function TIfxSQLVAR.DataWriteBuffer: PChar;
begin
  Result := FData^.sqldata;
  FModified := True;
end;

procedure TIfxSQLVAR.Validate(Buffer: Pointer);
begin
end;

function TIfxSQLVAR.ResetSubject: TLXDelegat;
begin
  if FOwner <> nil then
    Result := FOwner.ResetSubject else
    Result := nil;
end;

function TIfxSQLVAR.GetBufferSize: Integer;
begin
  if FValue <> nil then
    Result := FValue.BufferSize else
    Result := 0;
end;

function TIfxSQLVAR.GetIsNull: Boolean;
begin
  Result := FIsNull = -1;
end;

function TIfxSQLVAR.ActiveValue: TIfxValue;
begin
  if IsNull then
    Result := TIfxNullValue.Instance else
    Result := FValue;
end;

function TIfxSQLVAR.GetAsBCD: TBcd;
begin
  Result := ActiveValue.AsBCD;
end;

function TIfxSQLVAR.GetAsBoolean: Boolean;
begin
  Result := ActiveValue.AsBoolean;
end;

function TIfxSQLVAR.GetAsByte: TBlobByteData;
begin
  Result := ActiveValue.AsByte;
end;

function TIfxSQLVAR.GetAsCurrency: Currency;
begin
  Result := ActiveValue.AsCurrency;
end;

function TIfxSQLVAR.GetAsDate: int4;
begin
  Result := ActiveValue.AsDate;
end;

function TIfxSQLVAR.GetAsDateTime: TDateTime;
begin
  Result := ActiveValue.AsDateTime;
end;

function TIfxSQLVAR.GetAsDecimal: TDecimal;
begin
  Result := ActiveValue.AsDecimal;
end;

function TIfxSQLVAR.GetAsDTime: TDTime;
begin
  Result := ActiveValue.AsDTime;
end;

function TIfxSQLVAR.GetAsFloat: Double;
begin
  Result := ActiveValue.AsFloat;
end;

function TIfxSQLVAR.GetAsInt8: TIfx_int8;
begin
  Result := ActiveValue.AsInt8;
end;

function TIfxSQLVAR.GetAsInteger: Integer;
begin
  Result := ActiveValue.AsInteger;
end;

function TIfxSQLVAR.GetAsInterval: Intrvl;
begin
  Result := ActiveValue.AsInterval;
end;

function TIfxSQLVAR.GetAsLargeint: Largeint;
begin
  Result := ActiveValue.AsLargeint;
end;

function TIfxSQLVAR.GetAsLob: IIfxLob;
begin
  Result := ActiveValue.AsLob;
end;

function TIfxSQLVAR.GetAsLocator: PLoc;
begin
  Result := ActiveValue.AsLocator;
end;

function TIfxSQLVAR.GetAsSmallFloat: Single;
begin
  Result := ActiveValue.AsSmallFloat;
end;

function TIfxSQLVAR.GetAsSmallInt: int2;
begin
  Result := ActiveValue.AsSmallInt;
end;

function TIfxSQLVAR.GetAsSQLTimeStamp: TSQLTimeStamp;
begin
  Result := ActiveValue.AsSQLTimeStamp;
end;

function TIfxSQLVAR.GetAsString: string;
begin
  Result := ActiveValue.AsString;
end;

function TIfxSQLVAR.GetAsTime: TDateTime;
begin
  Result := ActiveValue.AsTime;
end;

function TIfxSQLVAR.GetAsVariant: Variant;
begin
  Result := ActiveValue.AsVariant;
end;

procedure TIfxSQLVAR.SetNull;
begin
  if Assigned(FValue) then
    FreeBuffer;
  FData^.sqltype := SQLNULL;
end;

procedure TIfxSQLVAR.SetIsNull(Value: Boolean);
begin
  if Value then SetNull else FIsNull := 0;
end;

procedure TIfxSQLVAR.SetTypedValue(sqltype: int2; sqllen: int4; sqlxid: int4;
  FieldValue: TIfxFieldValue);
begin
  try
    SetNull;
    FData^.sqltype := sqltype;
    FData^.sqllen := sqllen;
    FData^.sqlxid := sqlxid;
    FieldValue.AllocateBuffer(FData^.sqldata);
  except
    FieldValue.Free;
    raise;
  end;

  FValue := FieldValue;
  FIsNull := 0;

  FModified := True;
end;

procedure TIfxSQLVAR.SetTypedString(sqltype: int2; const Value: string;
  FieldValue: TIfxStringValue);
begin
  SetTypedValue(sqltype, Length(Value), 0, FieldValue);
  LXStrPCopy(FData^.sqldata, Value);
end;

procedure TIfxSQLVAR.SetTypedLocator(sqltype: int2; Size: Integer; Data: Pointer);
var
  LocatorValue: TIfxLocatorValue;
begin
  LocatorValue := TIfxLocatorValue.Create(Self);
  SetTypedValue(sqltype, SizeOf(TLoc), 0, LocatorValue);
  LocatorValue.SetTypedValue(sqltype, Size, Data);
end;

procedure TIfxSQLVAR.SetTypedLob(sqlxid: int4; const Value: IIfxLob;
  FieldValue: TIfxLobValue);
begin
  SetTypedValue(SQLUDTFIXED, SizeOf(TIfx_lo), sqlxid, FieldValue);
  FieldValue.AsLob := Value;
end;

procedure TIfxSQLVAR.SetAsBCD(const Value: TBcd);
begin
  SetTypedValue(SQLDECIMAL, $20FF, 0, TIfxDecimalValue.Create(Self));
  PDecimal(FData^.sqldata)^ := BcdToDecimal(Value);
end;

procedure TIfxSQLVAR.SetAsBlob(const Value: IIfxLob);
begin
  SetTypedLob(XID_BLOB, Value, TIfxBlobValue.Create(Self, GetLobBufferStrategy));
end;

procedure TIfxSQLVAR.SetAsBoolean(Value: Boolean);
begin
  SetTypedValue(SQLBOOL, SizeOf(Boolean), 0, TIfxBooleanValue.Create(Self));
  FData^.sqldata^ := Char(Value);
end;

procedure TIfxSQLVAR.SetAsByte(const Value: TBlobByteData);
begin
  SetTypedLocator(SQLBYTES, Length(Value), Pointer(Value));
end;

procedure TIfxSQLVAR.SetAsChar(const Value: string);
begin
  SetTypedString(SQLCHAR, Value, TIfxCharValue.Create(Self));
end;

procedure TIfxSQLVAR.SetAsClob(const Value: IIfxLob);
begin
  SetTypedLob(XID_CLOB, Value, TIfxClobValue.Create(Self, GetLobBufferStrategy));
end;

procedure TIfxSQLVAR.SetAsCurrency(Value: Currency);
begin
  SetTypedValue(SQLMONEY, $20FF, 0, TIfxMoneyValue.Create(Self));
  PDecimal(FData^.sqldata)^ := CurrencyToDecimal(Value);
end;

procedure TIfxSQLVAR.SetAsDate(Value: int4);
begin
  SetTypedValue(SQLDATE, SizeOf(int4), 0, TIfxDateValue.Create(Self));
  PInt4(FData^.sqldata)^ := Value;
end;

procedure TIfxSQLVAR.SetAsDateTime(Value: TDateTime);
begin
  SetTypedValue(SQLDTIME, 0, 0, TIfxDTimeValue.Create(Self));
  PDTime(FData^.sqldata)^ := DateTimeToDTime(Value);
  FData^.sqllen := PDTime(Buffer)^.dt_qual;
end;

procedure TIfxSQLVAR.SetAsDecimal(const Value: TDecimal);
begin
  SetTypedValue(SQLDECIMAL, $20FF, 0, TIfxDecimalValue.Create(Self));
  PDecimal(FData^.sqldata)^ := Value;
end;

procedure TIfxSQLVAR.SetAsDTime(const Value: TDTime);
begin
  SetTypedValue(SQLDTIME, Value.dt_qual, 0, TIfxDTimeValue.Create(Self));
  PDTime(FData^.sqldata)^ := Value;
end;

procedure TIfxSQLVAR.SetAsFloat(Value: Double);
begin
  SetTypedValue(SQLFLOAT, SizeOf(Double), 0, TIfxFloatValue.Create(Self));
  PDouble(FData^.sqldata)^ := Value;
end;

procedure TIfxSQLVAR.SetAsInt8(const Value: TIfx_int8);
begin
  SetTypedValue(SQLINT8, SizeOf(TIfx_int8), 0, TIfxInt8Value.Create(Self));
  PIfx_int8(FData^.sqldata)^ := Value;
end;

procedure TIfxSQLVAR.SetAsInteger(Value: int4);
begin
  SetTypedValue(SQLINT, SizeOf(int4), 0, TIfxIntegerValue.Create(Self));
  PInt4(FData^.sqldata)^ := Value;
end;

procedure TIfxSQLVAR.SetAsInterval(const Value: TIntrvl);
begin
  SetTypedValue(SQLINTERVAL, Value.in_qual, 0, TIfxIntervalValue.Create(Self));
  PIntrvl(FData^.sqldata)^ := Value;
end;

procedure TIfxSQLVAR.SetAsLargeint(Value: Largeint);
begin
  SetTypedValue(SQLINT8, SizeOf(TIfx_int8), 0, TIfxInt8Value.Create(Self));
  PIfx_int8(FData^.sqldata)^ := Int64ToInt8(Value);
end;

procedure TIfxSQLVAR.SetAsLocator(Value: PLoc);
begin
  with Value^ do
    SetTypedLocator(loc_type, loc_size, lc_union.lc_mem.lc_buffer);
end;

procedure TIfxSQLVAR.SetAsLVarChar(const Value: string);
begin
  SetTypedString(SQLLVARCHAR, Value, TIfxLVarCharValue.Create(Self));
end;

procedure TIfxSQLVAR.SetAsMoney(const Value: TDecimal);
begin
  SetTypedValue(SQLMONEY, $20FF, 0, TIfxMoneyValue.Create(Self));
  PDecimal(FData^.sqldata)^ := Value;
end;

procedure TIfxSQLVAR.SetAsNChar(const Value: string);
begin
  SetTypedString(SQLNCHAR, Value, TIfxNCharValue.Create(Self));
end;

procedure TIfxSQLVAR.SetAsNVarChar(const Value: string);
begin
  SetTypedString(SQLNVCHAR, Value, TIfxNVarCharValue.Create(Self));
end;

procedure TIfxSQLVAR.SetAsOpaque(const Value: string);
begin
  if not TIfxOpaqueValue.IsEnabled then
    IDACErrorFmt(S280ClientRequired, [Name]);
  SetTypedValue(CLVCHARPTRTYPE, 0, 0, TIfxOpaqueValue.Create(Self, 0));
  FValue.AsString := Value;
end;

procedure TIfxSQLVAR.SetAsSmallFloat(Value: Single);
begin
  SetTypedValue(SQLSMFLOAT, SizeOf(Single), 0, TIfxSmallFloatValue.Create(Self));
  PSingle(FData^.sqldata)^ := Value;
end;

procedure TIfxSQLVAR.SetAsSmallInt(Value: int2);
begin
  SetTypedValue(SQLSMINT, SizeOf(int2), 0, TIfxSmallIntValue.Create(Self));
  PInt2(FData^.sqldata)^ := Value;
end;

procedure TIfxSQLVAR.SetAsSQLTimeStamp(const Value: TSQLTimeStamp);
begin
  SetTypedValue(SQLDTIME, 0, 0, TIfxDTimeValue.Create(Self));
  PDTime(FData^.sqldata)^ := TimeStampToDTime(Value);
  FData^.sqllen := PDTime(FData^.sqldata)^.dt_qual;
end;

procedure TIfxSQLVAR.SetAsText(const Value: string);
begin
  SetTypedLocator(SQLTEXT, Length(Value), PChar(Value));
end;

procedure TIfxSQLVAR.SetAsTime(Value: TDateTime);
begin
  SetTypedValue(SQLDTIME, 0, 0, TIfxDTimeValue.Create(Self));
  PDTime(FData^.sqldata)^ := TimeToDTime(Value);
  FData^.sqllen := PDTime(FData^.sqldata)^.dt_qual;
end;

procedure TIfxSQLVAR.SetAsVarChar(const Value: string);
begin
  SetTypedString(SQLVCHAR, Value, TIfxVarCharValue.Create(Self));
end;

procedure TIfxSQLVAR.SetAsVariant(const Value: Variant);
var
  P: Pointer;
begin
  if LXVarIsNull(Value) then
    SetNull
  else
    case LXVarType(Value) of
      varEmpty, varNull:
        SetNull;
      varSmallint, varShortInt, varByte, varWord:
        AsSmallInt := Value;
      varInteger, varLongWord:
        AsInteger := Value;
      varSingle:
        AsSmallFloat := Value;
      varDouble:
        AsFloat := Value;
      varCurrency:
        AsCurrency := Value;
      varDate:
        AsDateTime := Value;
      varOleStr, varString:
        AsString := Value;
      varBoolean:
        AsBoolean := Value;
    else
      if (LXVarType(Value) <> (varArray or varByte)) or (LXVarArrayDimCount(Value) <> 1) then
        IDACErrorFmt(SUnsupportedValueType, [Name]) else
      begin
        P := LXVarArrayLock(Value);
        try
          SetTypedLocator(SQLBYTES, LXVarArrayHighBound(Value, 1) -
            LXVarArrayLowBound(Value, 1) + 1, P);
        finally
          LXVarArrayUnlock(Value);
        end;
      end;
    end;
end;

function TIfxSQLVAR.GetLobBufferStrategy: TIfxLobBufferStrategy;
begin
  if (FOwner = nil) or (FOwner.LobBufferStrategy = nil) then
    IDACErrorFmt(SCannotHanldeLob, [Name]);
  Result := FOwner.LobBufferStrategy;
end;

procedure TIfxSQLVAR.AllocateBuffer;
begin
  if FValue <> nil then Exit;

  case FData^.sqlxid of
    XID_LVARCHAR: FValue := TIfxLVarCharValue.Create(Self);
    XID_BOOLEAN: FValue := TIfxBooleanValue.Create(Self);
    XID_BLOB: FValue := TIfxBlobValue.Create(Self, GetLobBufferStrategy);
    XID_CLOB: FValue := TIfxClobValue.Create(Self, GetLobBufferStrategy);
    else
      case MASKNONULL(Data^.sqltype) of
        SQLCHAR: FValue := TIfxCharValue.Create(Self);
        SQLSMINT: FValue := TIfxSmallIntValue.Create(Self);
        SQLINT, SQLSERIAL: FValue := TIfxIntegerValue.Create(Self);
        SQLFLOAT: FValue := TIfxFloatValue.Create(Self);
        SQLSMFLOAT: FValue := TIfxSmallFloatValue.Create(Self);
        SQLDECIMAL: FValue := TIfxDecimalValue.Create(Self);
        SQLDATE: FValue := TIfxDateValue.Create(Self);
        SQLMONEY: FValue := TIfxMoneyValue.Create(Self);
        SQLDTIME: FValue := TIfxDTimeValue.Create(Self);
        SQLBYTES, SQLTEXT: FValue := TIfxLocatorValue.Create(Self);
        SQLVCHAR: FValue := TIfxVarCharValue.Create(Self);
        SQLINTERVAL: FValue := TIfxIntervalValue.Create(Self);
        SQLNCHAR: FValue := TIfxNCharValue.Create(Self);
        SQLNVCHAR: FValue := TIfxNVarCharValue.Create(Self);
        SQLINT8, SQLSERIAL8: FValue := TIfxInt8Value.Create(Self);
        CLVCHARPTRTYPE: FValue := TIfxOpaqueValue.Create(Self, 1);
        SQLLVARCHAR: FValue := TIfxLVarCharValue.Create(Self);
        SQLBOOL: FValue := TIfxBooleanValue.Create(Self);
        else
          IDACErrorFmt(SUnsupportedFieldType, [TypeName, Name]);
      end;
  end;
  FValue.AllocateBuffer(FData^.sqldata);
end;

procedure TIfxSQLVAR.FreeBuffer;
begin
  if FValue = nil then Exit;

  FValue.FreeBuffer(FData^.sqldata);
  FData^.sqldata := nil;
  FreeAndNil(FValue);
  FIsNull := -1;
end;

procedure TIfxSQLVAR.SetBlobType(BlobType: TBlobType);
begin
  SetNull;
  
  case BlobType of
    ftBlob, ftGraphic:
      SetTypedValue(SQLBYTES, SizeOf(TLoc), 0, TIfxLocatorValue.Create(Self));
    ftMemo, ftFmtMemo:
      SetTypedValue(SQLTEXT, SizeOf(TLoc), 0, TIfxLocatorValue.Create(Self));
    ftTypedBinary:
      SetTypedValue(CLVCHARPTRTYPE, 0, 0, TIfxOpaqueValue.Create(Self, 0));
    ftOraBlob:
      SetTypedValue(SQLUDTFIXED, SizeOf(TIfx_lo), XID_BLOB,
        TIfxBlobValue.Create(Self, GetLobBufferStrategy));
    ftOraClob:
      SetTypedValue(SQLUDTFIXED, SizeOf(TIfx_lo), XID_CLOB,
        TIfxClobValue.Create(Self, GetLobBufferStrategy));
    else
      IDACErrorFmt(SUnsupportedValueType, [Name]);
  end;
end;

function TIfxSQLVAR.Format(const FmtStr: string): string;
begin
  Result := ActiveValue.Format(FmtStr);
end;

procedure TIfxSQLVAR.SaveToStream(Stream: TStream);
begin
  ActiveValue.SaveToStream(Stream);
end;

procedure TIfxSQLVAR.SaveToFile(const FileName: string);
begin
  ActiveValue.SaveToFile(FileName);
end;

procedure TIfxSQLVAR.LoadFromStream(Stream: TStream; BlobType: TBlobType);
begin
  SetBlobType(BlobType);
  FValue.LoadFromStream(Stream);
end;

procedure TIfxSQLVAR.LoadFromFile(const FileName: string; BlobType: TBlobType);
begin
  SetBlobType(BlobType);
  FValue.LoadFromFile(FileName);
end;

procedure TIfxSQLVAR.AssignValue(const Value: IIfxValue);
begin
  if Value <> nil then
    Value.AssignToValue(Self);
end;

procedure TIfxSQLVAR.AssignParam(Param: TParam);
var
  DataStr: string;
begin
  if Param = nil then Exit; 

  if Param.IsNull then
    SetNull
  else
    case Param.DataType of
      ftString, ftWideString:
        AsString := Param.AsString;
      ftSmallint, ftWord:
        AsSmallInt := Param.AsSmallInt;
      ftInteger, ftAutoInc:
        AsInteger := Param.AsInteger;
      ftBoolean:
        AsBoolean := Param.AsBoolean;
      ftFloat:
        AsFloat := Param.AsFloat;
      ftCurrency:
        AsCurrency := Param.AsCurrency;
      ftDate:
        AsDate := DateTimeToDate(Param.AsDateTime);
      ftTime:
        AsTime := Param.AsDateTime;
      ftDateTime:
        AsDateTime := Param.AsDateTime;
      ftBlob, ftGraphic:
        begin
          //!!!DataStr := Param.AsBlob;
          SetTypedLocator(SQLBYTES, Length(DataStr), PChar(DataStr));
        end;
      ftMemo, ftFmtMemo:
        AsText := Param.AsMemo;
      ftFixedChar:
        AsChar := Param.AsString;
      ftLargeint:
        AsInt8 := StringToInt8(Param.AsString);
{$IFNDEF D6}
      ftBCD:
        AsDecimal := CurrencyToDecimal(Param.AsBCD);
{$ELSE}
      ftBCD, ftFMTBcd:
        AsBCD := Param.AsFMTBcd;
      ftTimeStamp:
        AsSQLTimeStamp := Param.AsSQLTimeStamp;
{$ENDIF}
    else
      IDACErrorFmt(SUnsupportedValueType, [Name]);
    end;
end;

procedure TIfxSQLVAR.AssignField(Field: TField);
var
  Lob: IIfxLob;
  BlobData: TLXBlobData;
  BlobStream: TStream;
  LargeintValue: Largeint;
  BcdValue: TBcd;
begin
  if Field = nil then Exit;

  if Field is TIfxNativeField then
    AssignValue(TIfxNativeField(Field))

  else if Field.IsNull then
    SetNull

  else if Field.IsBlob then
    if Field.DataSet is TIfxCustomDataSet then
    begin
      SetBlobType(Field.DataType);
      if Field.DataType in [ftOraBlob, ftOraClob] then
      begin
        TIfxCustomDataSet(Field.DataSet).GetFieldData(Field, @Lob);
        FValue.AsLob := Lob;
      end else
      begin
        TIfxCustomDataSet(Field.DataSet).GetFieldData(Field, @BlobData);
        FValue.AsString := BlobData;
      end;
    end else
    begin
      BlobStream := Field.DataSet.CreateBlobStream(Field, bmRead);
      try
        LoadFromStream(BlobStream, Field.DataType);
      finally
        BlobStream.Free;
      end;
    end

  else if Field is TStringField then
    if TStringField(Field).FixedChar then
      AsChar := Field.AsString else
      AsString := Field.AsString

  else
    case Field.DataType of
      ftString, ftWideString:
        AsString := Field.AsString;
      ftSmallint, ftWord:
        AsSmallInt := Field.AsInteger;
      ftInteger, ftAutoInc:
        AsInteger := Field.AsInteger;
      ftBoolean:
        AsBoolean := Field.AsBoolean;
      ftFloat:
        AsFloat := Field.AsFloat;
      ftCurrency:
        AsCurrency := Field.AsCurrency;
      ftBCD:
        if not (Field is TBCDField) then
          AsDecimal := CurrencyToDecimal(Field.AsCurrency) else
        begin
          Field.GetData(@BcdValue);
          AsBCD := BcdValue;
        end;
      ftDate:
        AsDate := DateTimeToDate(Field.AsDateTime);
      ftTime:
        AsTime := Field.AsDateTime;
      ftDateTime:
        AsDateTime := Field.AsDateTime;
      ftFixedChar:
        AsChar := Field.AsString;
      ftLargeint:
        if not (Field is TLargeintField) then
          AsInt8 := StringToInt8(Field.AsString) else
        begin
          Field.GetData(@LargeintValue);
          AsLargeint := LargeintValue;
        end;
{$IFDEF D6}
      ftFMTBcd:
        AsBCD := Field.AsBCD;
      ftTimeStamp:
        AsSQLTimeStamp := Field.AsSQLTimeStamp;
{$ENDIF}
    else
      IDACErrorFmt(SUnsupportedValueType, [Name]);
    end;
end;

procedure TIfxSQLVAR.AssignToValue(const Value: IIfxValue);
begin
  if Value <> nil then
    ActiveValue.AssignTo(Value);
end;

procedure TIfxSQLVAR.AssignToParam(Param: TParam);
begin
  if IsNull then
    Param.Value := LXNull else
  begin
    Param.DataType := TIfxFieldTypes.DefaultTypes.GetMapping(DataType, Size, ExtendedType);
    Param.Value := FValue.AsVariant;
  end;
end;

procedure TIfxSQLVAR.AssignToField(Field: TField);
var
  Lob: IIfxLob;
  BlobData: TLXBlobData;
  BlobStream: TStream;
  LargeintValue: Largeint;
  BcdValue: TBcd;
begin
  if Field = nil then Exit;

  if Field is TIfxNativeField then
    AssignToValue(TIfxNativeField(Field))

  else if IsNull then
    Field.Clear

  else if Field.IsBlob then
    if Field.DataSet is TIfxCustomDataSet then
    begin
      if Field.DataType in [ftOraBlob, ftOraClob] then
      begin
        Lob := FValue.AsLob;
        Field.SetData(@Lob);
      end else
      begin
        BlobData := FValue.AsString;
        Field.SetData(@BlobData);
      end;
    end else
    begin
      BlobStream := Field.DataSet.CreateBlobStream(Field, bmWrite);
      try
        SaveToStream(BlobStream);
      finally
        BlobStream.Free;
      end
    end

  else
    case Field.DataType of
      ftString, ftFixedChar:
        Field.AsString := FValue.AsString;
      ftSmallint:
        Field.AsInteger := FValue.AsSmallInt;
      ftInteger, ftAutoInc:
        Field.AsInteger := FValue.AsInteger;
      ftBoolean:
        Field.AsBoolean := FValue.AsBoolean;
      ftFloat:
        Field.AsFloat := FValue.AsFloat;
      ftCurrency:
        Field.AsCurrency := FValue.AsCurrency;
      ftBCD:
        if not (Field is TBCDField) then
          Field.AsCurrency := FValue.AsCurrency else
        begin
          BcdValue := FValue.AsBCD;
          Field.SetData(@BcdValue);
        end;
      ftDate, ftTime, ftDateTime:
        Field.AsDateTime := FValue.AsDateTime;
      ftLargeint:
        if not (Field is TLargeintField) then
          Field.AsString := FValue.AsString else
        begin
          LargeintValue := FValue.AsLargeint;
          TLargeintField(Field).SetData(@LargeintValue);
        end;
{$IFDEF D6}
      ftFMTBcd:
        Field.AsBCD := FValue.AsBCD;
      ftTimeStamp:
        Field.AsSQLTimeStamp := FValue.AsSQLTimeStamp;
{$ENDIF}
      else
        Field.Value := FValue.AsVariant;
    end;
end;


{ TIfxSQLDA }

constructor TIfxSQLDA.Create;
begin
  inherited;
  FSQLVARs := TList.Create;
end;

destructor TIfxSQLDA.Destroy;
begin
  Clear;
  FSQLVARs.Free;
  inherited;
end;

function TIfxSQLDA.GetCount: Integer;
begin
  Result := FSQLVARs.Count;
end;

function TIfxSQLDA.GetItem(Index: Integer): TIfxSQLVAR;
begin
  Result := FSQLVARs[Index];
end;

function TIfxSQLDA.GetModified: Boolean;
var
  I: Integer;
begin
  Result := True;
  for I := 0 to Count - 1 do
    if Items[I].Modified then Exit;
  Result := False;
end;

procedure TIfxSQLDA.SetModified(Value: Boolean);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Items[I].Modified := Value;
end;

procedure TIfxSQLDA.AllocateBuffers;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Items[I].AllocateBuffer;
end;

procedure TIfxSQLDA.FreeBuffers;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Items[I].FreeBuffer;
end;

function TIfxSQLDA.IndexOf(Item: TIfxSQLVAR): Integer;
begin
  Result := FSQLVARs.IndexOf(Item);
end;

function TIfxSQLDA.FindSQLVAR(const Name: string): TIfxSQLVAR;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
  begin
    Result := GetItem(I);
    if CompareText(Result.Name, Name) = 0 then Exit;
  end;
  Result := nil;
end;

function TIfxSQLDA.SQLVARByName(const Name: string): TIfxSQLVAR;
begin
  Result := FindSQLVAR(Name);
  if Result = nil then
    IDACErrorFmt(SHostVariableNotFound, [Name]);
end;

procedure TIfxSQLDA.AssignValues(Source: TIfxSQLDA);
var
  I: Integer;
  SQLVAR: TIfxSQLVAR;
begin
  for I := 0 to Count - 1 do
  begin
    SQLVAR := Source.FindSQLVAR(Items[I].Name);
    if SQLVAR <> nil then
      Items[I].AssignValue(SQLVAR);
  end;
end;

procedure TIfxSQLDA.AssignValues(Source: TParams);
var
  I: Integer;
  Param: TParam;
begin
  for I := 0 to Count - 1 do
  begin
    Param := Source.FindParam(Items[I].Name);
    if Param <> nil then
      Items[I].AssignParam(Param);
  end;
end;

procedure TIfxSQLDA.AssignValues(Source: TFields);
var
  I: Integer;
  Field: TField;
begin
  for I := 0 to Count - 1 do
  begin
    Field := Source.FindField(Items[I].Name);
    if Field <> nil then
      Items[I].AssignField(Field);
  end;
end;

procedure TIfxSQLDA.Clear;
var
  I: Integer;
begin
  if FSQLDA = nil then Exit;

  for I := 0 to FSQLVARs.Count - 1 do
    TIfxSQLVAR(FSQLVARs[I]).Free;
  FSQLVARs.Clear;
  
  FreeSQLDA;
  FSQLDA := nil;
end;


{ TIfxParam }

constructor TIfxParam.Create(Data: PIfx_sqlvar);
begin
  inherited;
  FData^.sqltype := SQLNULL;
end;

function TIfxParam.GetName: string;
begin
  Result := FName;
end;

procedure TIfxParam.SetName(const Value: string);
begin
  FName := Value;
end;


{ TIfxParams }

procedure TIfxParams.Reset(Count: Integer);
var
  sqlvar: PIfx_sqlvar;
  Param: TIfxParam;
  I: Integer;
begin
  Clear;
  if Count = 0 then Exit;

  FSQLDA := AllocMem(SizeOf(TIfx_SQLDA));

  FSQLDA^.sqlvar := AllocMem(Count*SizeOf(TIfx_sqlvar));
  FSQLDA^.sqld := Count;

  sqlvar := FSQLDA^.sqlvar;
  for I := 0 to Count - 1 do
  begin
    Param := TIfxParam.Create(sqlvar);
    Param.FOwner := Self;
    Param.FIndex := I;
    FSQLVARs.Add(Param);
    Inc(sqlvar);
  end;
end;

function TIfxParams.FindParam(const Name: string): TIfxParam;
begin
  Result := TIfxParam(FindSQLVAR(Name));
end;

function TIfxParams.ParamByName(const Name: string): TIfxParam;
begin
  Result := TIfxParam(SQLVARByName(Name));
end;

procedure TIfxParams.FreeSQLDA;
begin
  if FSQLDA^.sqlvar <> nil then
    FreeMem(FSQLDA^.sqlvar);
  FreeMem(FSQLDA);
end;

function TIfxParams.ResetSubject: TLXDelegat;
begin
  Result := nil;
end;

function TIfxParams.GetItem(Index: Integer): TIfxParam;
begin
  Result := TIfxParam(inherited GetItem(Index));
end;

procedure TIfxParams.Assign(Source: TIfxSQLDA);
var
  I: Integer;
begin
  Reset(Source.Count);

  for I := 0 to Count - 1 do
  begin
    Items[I].Name := Source[I].Name;
    Items[I].AssignValue(Source[I]);
  end;
end;

procedure TIfxParams.Assign(Source: TParams);
var
  I: Integer;
begin
  Reset(Source.Count);

  for I := 0 to Count - 1 do
  begin
    Items[I].Name := Source[I].Name;
    Items[I].AssignParam(Source[I]);
  end;
end;

procedure TIfxParams.Assign(Source: TFields);
var
  I: Integer;
begin
  Reset(Source.Count);
  
  for I := 0 to Count - 1 do
  begin
    Items[I].Name := Source[I].FieldName;
    Items[I].AssignField(Source[I]);
  end;
end;


{ TIfxField }

constructor TIfxField.Create(Data: PIfx_sqlvar);
begin
  inherited;
  AdjustType(Data^.sqltype, Data^.sqllen, Data^.sqlxid, False);
end;

class procedure TIfxField.AdjustType(var sqltype: int2; var sqllen, sqlxid: int4;
  OnlyInfo: Boolean);
begin
  if TIfxFieldTypes.IsStringType(sqltype, sqlxid) then
  begin
    if ISVCTYPE(sqltype) then
      sqllen := VCMAX(sqllen);
    if sqllen = 0 then
      if sqlxid = XID_LVARCHAR then
        sqllen := 2048 else
        sqllen := 1;
    if not OnlyInfo then
      Inc(sqllen);
  end else

  if TIfxFieldTypes.IsOpaqueType(sqltype, sqlxid) then
    if TIfxOpaqueValue.IsEnabled then
    begin
      sqltype := CLVCHARPTRTYPE or (sqltype and SQLNONULL);
      sqllen := 0;
      sqlxid := 0;
    end else
    begin
      sqltype := SQLLVARCHAR or (sqltype and SQLNONULL);
      if not OnlyInfo then
        sqllen := 2049 else
        sqllen := 2048;
      sqlxid := XID_LVARCHAR;
    end;
end;

function TIfxField.GetName: string;
begin
  Result := FData^.sqlname;
end;

procedure TIfxField.SetName(const Value: string);
begin
  IDACError(SFieldNameIsReadOnly);
end;


{ TIfxFields }

constructor TIfxFields.Create;
begin
  inherited;
  FBufferResetSubject := TLXDelegat.Create;
end;

destructor TIfxFields.Destroy;
begin
  FBufferResetSubject.Free;
  inherited;
end;

function TIfxFields.GetItem(Index: Integer): TIfxField;
begin
  Result := TIfxField(inherited GetItem(Index));
end;

function TIfxFields.GetRecordSize: Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Count - 1 do
    Result := Result + Items[I].BufferSize;
end;

function TIfxFields.ResetSubject: TLXDelegat;
begin
  Result := FBufferResetSubject;
end;

procedure TIfxFields.FreeSQLDA;
begin
  SQLFreeMem(FSQLDA, SQLDA_FREE);
end;

procedure TIfxFields.Reset(SQLDA: PIfx_SQLDA);
var
  I: Integer;
  sqlvar: PIfx_sqlvar;
  Field: TIfxField;
begin
  Clear;
  if SQLDA = nil then Exit;

  FSQLDA := SQLDA;

  sqlvar := FSQLDA^.sqlvar;
  for I := 0 to FSQLDA^.sqld - 1 do
  begin
    Field := TIfxField.Create(sqlvar);
    Field.FOwner := Self;
    Field.FIndex := I;
    FSQLVARs.Add(Field);
    Inc(sqlvar);
  end;
end;

function TIfxFields.FindField(const Name: string): TIfxField;
begin
  Result := TIfxField(FindSQLVAR(Name));
end;

function TIfxFields.FieldByName(const Name: string): TIfxField;
begin
  Result := TIfxField(SQLVARByName(Name));
end;


{ TIfxCustomSQL }

constructor TIfxCustomSQL.Create(AOwner: TComponent);
begin
  inherited;

  FSQL := TStringList.Create;
  TStringList(FSQL).OnChanging := MacroSQLChanging;
  TStringList(FSQL).OnChange := MacroSQLChanged;
  FMacros := TStringList.Create;
  TStringList(FMacros).OnChanging := MacroSQLChanging;
  TStringList(FMacros).OnChange := MacrosChanged;

  FLobBufferStrategy := TIfxLobBufferStrategy.Create(Self);
  FParams := TIfxParams.Create;
  FParams.LobBufferStrategy := FLobBufferStrategy;
  FFields := TIfxFields.Create;
  FFields.LobBufferStrategy := FLobBufferStrategy;

  FParamCheck := IFX_DEFAULT_PARAM_CHECK;
  FCacheHandle := IFX_DEFAULT_CACHE_HANDLE;

  FRowsAffected := -1;
end;

destructor TIfxCustomSQL.Destroy;
begin
  SetPrepared(False);

  FFields.Free;
  FParams.Free;
  FLobBufferStrategy.Free;
  FMacros.Free;
  FMacroSQLElement.Free;
  SetSQLProcessor(nil);
  FSQL.Free;

  inherited;
end;

procedure TIfxCustomSQL.SetSQL(Value: TStrings);
begin
  FSQL.Assign(Value);
end;

procedure TIfxCustomSQL.SetSQLProcessor(Value: TIfxSQLProcessor);
begin
  if Value <> FSQLProcessor then
  begin
    if FSQLProcessor <> nil then
      FSQLProcessor.RemoveFreeNotification(Self);
    FSQLProcessor := Value;
    if FSQLProcessor <> nil then
      FSQLProcessor.FreeNotification(Self);
  end;
end;

function TIfxCustomSQL.GetActiveSQLProcessor: TIfxSQLProcessor;
begin
  Result := FSQLProcessor;
  if Result = nil then
    if Connection <> nil then
      Result := Connection.ActiveSQLProcessor else
      Result := TIfxSQLProcessor.DefaultProcessor;
end;

procedure TIfxCustomSQL.SetMacros(Value: TStrings);
begin
  FMacros.Assign(Value);
end;

procedure TIfxCustomSQL.SetScrollable(Value: Boolean);
begin
  CheckClosed;
  FScrollable := Value;
end;

function TIfxCustomSQL.GetPrepared: Boolean;
begin
  Result := FResource <> nil;
end;

procedure TIfxCustomSQL.SetPrepared(Value: Boolean);
begin
  if Prepared <> Value then
    if not Value then
      InternalUnprepare else
    begin
      CheckConnection;
      NotifyMonitor(meInformation, PrepareMessageProc, []);
      Connection.Activate;
      InternalPrepare;
    end;
end;

function TIfxCustomSQL.GetHandle: PIfx_Cursor;
begin
  if Prepared then
    Result := FResource.Handle else
    Result := nil;
end;

function TIfxCustomSQL.GetStmtType: Integer;
begin
  CheckPrepared;
  Result := FResource.Handle^._SQCstmttype;
end;

function TIfxCustomSQL.GetParamCount: Integer;
begin
  Result := FParams.Count;
end;

function TIfxCustomSQL.GetCursorName: string;
begin
  CheckOpen;
  Result := FCursor^._SQCname;
end;

function TIfxCustomSQL.GetFieldCount: Integer;
begin
  Result := FFields.Count;
end;

procedure TIfxCustomSQL.MacroSQLChanging(Sender: TObject);
begin
  SetPrepared(False);
end;

procedure TIfxCustomSQL.MacroSQLChanged(Sender: TObject);
begin
  if not (csLoading in ActiveComponentState) then
    SafeParseMacroSQL;
end;

procedure TIfxCustomSQL.MacrosChanged(Sender: TObject);
begin
  if FMacroSQLElement <> nil then
    try
      BuildText;
    except
      FText := '';
    end;
end;

function TIfxCustomSQL.PrepareMessageProc(const Args: array of const): string;
begin
  Result := Name + ': ' + SNotifyPrepare + SLineBreak + Trim(FSQL.Text) + SLineBreak;
end;

function TIfxCustomSQL.ExecMessageProc(const Args: array of const): string;
var
  I: Integer;
  Literal: string;
begin
  for I := 0 to FParams.Count - 1 do
    with FParams[I] do
    begin
      if IsNull then
        Literal := SNotifyIsNull
      else
        try
          Literal := '= ''' + AsString + '''';
        except
          Literal := SNotifyIsNotNull;
        end;
      Result := Result + SLineBreak + SysUtils.Format('%s %s -- %s', [Name,
        Literal, TypeName]);
    end;

  Result := Name + ': ' + string(Args[0].VAnsiString) + SLineBreak +
    Trim(FSQL.Text) + SLineBreak + SLineBreak +
    Format(SNotifyParamCount, [FParams.Count]) + Result + SLineBreak;
end;

function TIfxCustomSQL.ActiveComponentState: TComponentState;
begin
  Result := ComponentState;
end;

procedure TIfxCustomSQL.Loaded;
begin
  try
    CheckText;
  except
    if csDesigning in ActiveComponentState then
      LXApplicationHandleException(Self) else
      raise;
  end;
  inherited;
  TIDACEvents.HandleObjectLoaded(Self);
end;

procedure TIfxCustomSQL.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FSQLProcessor) then
    FSQLProcessor := nil;
end;

procedure TIfxCustomSQL.HandleDatabaseChange;
begin
  if FResource = nil then Exit;

  FResource.HandleDatabaseChange;
  FResource := nil;
  FCursor := nil;
  FFields.Clear;
  FBOF := False;
  FEOF := False;
end;

procedure TIfxCustomSQL.InternalParseMacroSQL;
begin
  FreeAndNil(FMacroSQLElement);
  if not FParamCheck then
    FText := Trim(FSQL.Text) else
  begin
    FText := '';
    FMacroSQLElement := ActiveSQLProcessor.Parse(FSQL.Text);
    BuildText;
  end;
end;

procedure TIfxCustomSQL.SafeParseMacroSQL;
begin
  try
    InternalParseMacroSQL;
  except
  end;
end;

procedure TIfxCustomSQL.SetText(const Value: string);
begin
  FText := Value;
end;

procedure TIfxCustomSQL.BuildText;

  procedure UpdateParams(ParamNames: TStrings);
  var
    TmpParams: TIfxParams;
    I: Integer;
  begin
    if ParamNames.Count = 0 then
      FParams.Clear else
    begin
      TmpParams := TIfxParams.Create;
      try
        TmpParams.Assign(FParams);
        FParams.Reset(ParamNames.Count);
        for I := 0 to ParamNames.Count - 1 do
          FParams[I].Name := ParamNames[I];
        FParams.AssignValues(TmpParams);
      finally
        TmpParams.Free;
      end;
    end;
  end;

  procedure UpdateSourceParams(ParamNames: TStrings);
  var
    TmpParams: TParams;
    I: Integer;
  begin
    if ParamNames.Count = 0 then
      FSourceParams.Clear else
    begin
      TmpParams := TParams.Create;
      try
        for I := 0 to ParamNames.Count - 1 do
          TmpParams.CreateParam(ftUnknown, ParamNames[I], ptInput);
        TmpParams.AssignValues(FSourceParams);
        FSourceParams.Assign(TmpParams);
      finally
        TmpParams.Free;
      end;
    end;
  end;

var
  MacroSQLResult: ILXMacroSQLResult;
begin
  MacroSQLResult := ActiveSQLProcessor.Build(FMacroSQLElement, FMacros);
  FText := Trim(MacroSQLResult.SQL);
  if FSourceParams = nil then
    UpdateParams(MacroSQLResult.ParamNames) else
    UpdateSourceParams(MacroSQLResult.ParamNames);
end;

procedure TIfxCustomSQL.CheckText;
begin
  if (FText = '') and (FSQL.Count <> 0) then
    if FMacroSQLElement = nil then
      InternalParseMacroSQL else
      BuildText;
end;

procedure TIfxCustomSQL.CheckPrepared;
begin
  if not Prepared then
    IDACError(SSQLUnprepared, Self);
end;

procedure TIfxCustomSQL.CheckUnprepared;
begin
  if Prepared then
    IDACError(SSQLPrepared, Self);
end;

procedure TIfxCustomSQL.CheckOpen;
begin
  if not IsCursorOpen then
    IDACError(SSQLClosed, Self);
end;

procedure TIfxCustomSQL.CheckClosed;
begin
  if IsCursorOpen then
    IDACError(SSQLOpened, Self);
end;

procedure TIfxCustomSQL.InternalPrepare;
begin
  CheckText;
  if FText = '' then
    IDACError(SSQLEmpty, Self);

  FResource := AllocateStatement(FText, FCacheHandle);

  if FResource.HasResults then
    FFields.Reset(FResource.Describe);
end;

procedure TIfxCustomSQL.InternalOpen;
var
  Flags: Integer;
begin
  if CheckConnection.CommitRetain then
    Flags := CURSOR_FLAG_WITH_HOLD else
    Flags := 0;

  if FScrollable then
    Flags := Flags or CURSOR_FLAG_SCROLL;

  FRowsAffected := -1;

  if FSourceParams <> nil then
    FParams.Assign(FSourceParams);
  try
    NotifyMonitor(meInformation, ExecMessageProc, [SNotifyOpen]);
    Connection.Activate;
    if not Prepared then InternalPrepare;
    FFields.AllocateBuffers;
    FResource.Open(FParams.SQLDA, Flags, FCursor);
  finally
    if FSourceParams <> nil then
      FParams.Clear;
  end;
  
  FRowsAffected := Connection.RowsAffected;

  FBOF := True;
  FEOF := False;
end;

procedure TIfxCustomSQL.InternalClose;
begin
  try
    Connection.MakeCurrent;
    FResource.Close(FCursor);
  except
    on E: Exception do
      if Assigned(FOnCloseError) then FOnCloseError(E);
  end;
  FCursor := nil;
  FEOF := False;
  FBOF := False;
end;

procedure TIfxCustomSQL.InternalUnprepare;
begin
  Close;
  if FResource = nil then Exit;
  
  FFields.Clear;
  try
    FResource.Release;
  except
    on E: Exception do
      if Assigned(FOnUnprepareError) then FOnUnprepareError(E);
  end;
  FResource := nil;
  FRowsAffected := -1;
end;

procedure TIfxCustomSQL.Fetch(Direction: mint; Distance: Integer);
begin
  CheckOpen;

  Connection.MakeCurrent;

  FFields.ResetSubject.Notify(nil);
  if FResource.Fetch(FCursor, FFields.SQLDA, Direction, Distance) <> SQLNOTFOUND then
  begin
    FBOF := False;
    FEOF := False;
  end else
    case Direction of
      SCROLL_DIRECTION_NEXT: FEOF := True;
      SCROLL_DIRECTION_PRIOR: FBOF := True;
      SCROLL_DIRECTION_ABSOLUTE:
        if Distance > 0 then
          FEOF := True else
          FBOF := True;
      SCROLL_DIRECTION_RELATIVE:
        if Distance > 0 then
          FEOF := True else
        if Distance < 0 then
          FBOF := True;
    end;
end;

procedure TIfxCustomSQL.ParseMacroSQL;
begin
  CheckUnprepared;
  InternalParseMacroSQL;
end;

function TIfxCustomSQL.ExecuteDirect: int4;
begin
  CheckClosed;
  FRowsAffected := -1;
  Result := CheckConnection.Execute(FSQL.Text);
  FRowsAffected := Result;
end;

procedure TIfxCustomSQL.Prepare;
begin
  SetPrepared(True);
end;

procedure TIfxCustomSQL.Unprepare;
begin
  SetPrepared(False);
end;

function TIfxCustomSQL.ParamByName(const ParamName: string): TIfxParam;
begin
  Result := TIfxParam(FParams.SQLVARByName(ParamName));
end;

function TIfxCustomSQL.Execute: int4;
begin
  CheckConnection;

  FRowsAffected := -1;

  if FSourceParams <> nil then
    FParams.Assign(FSourceParams);
  try
    NotifyMonitor(meInformation, ExecMessageProc, [SNotifyExecute]);
    Connection.Activate;
    if not Prepared then InternalPrepare;
    FFields.AllocateBuffers;
    FResource.Execute(FParams.SQLDA, FFields.SQLDA);
  finally
    if FSourceParams <> nil then
      FParams.Clear;
  end;

  Result := Connection.RowsAffected;
  FRowsAffected := Result;
end;

procedure TIfxCustomSQL.Open;
begin
  if not IsCursorOpen then
    InternalOpen;
end;

procedure TIfxCustomSQL.Close;
begin
  FFields.FreeBuffers;
  if IsCursorOpen then
    InternalClose;
end;

function TIfxCustomSQL.IsCursorOpen: Boolean;
begin
  Result := FCursor <> nil;
end;

procedure TIfxCustomSQL.Next;
begin
  Fetch(SCROLL_DIRECTION_NEXT, 0);
end;

procedure TIfxCustomSQL.Prior;
begin
  Fetch(SCROLL_DIRECTION_PRIOR, 0);
end;

procedure TIfxCustomSQL.MoveTo(Position: Integer);
begin
  Fetch(SCROLL_DIRECTION_ABSOLUTE, Position);
end;

procedure TIfxCustomSQL.MoveBy(Distance: Integer);
begin
  Fetch(SCROLL_DIRECTION_RELATIVE, Distance);
end;

function TIfxCustomSQL.FieldByName(const FieldName: string): TIfxField;
begin
  Result := TIfxField(FFields.SQLVARByName(FieldName));
end;


{ TIfxSQL }

constructor TIfxSQL.Create(AOwner: TComponent);
begin
  inherited;
  FToFirstRecord := True;
end;

procedure TIfxSQL.AfterConstruction;
begin
  inherited;
  TIDACEvents.HandleObjectCreate(Self);
end;

procedure TIfxSQL.BeforeDestruction;
begin
  TIDACEvents.HandleObjectDestroy(Self);
  inherited;
end;

function TIfxSQL.GetVersion: string;
begin
  Result := IDACVersion;
end;

procedure TIfxSQL.SetVersion(const Value: string);
begin
end;

procedure TIfxSQL.ConnectionStateChange(Sender: TObject; Connecting: Boolean);
begin
  if not Connecting then
    ConnectionClosing;
end;

procedure TIfxSQL.InternalOpen;
begin
  inherited;
  if FToFirstRecord then Next;
  CountHolder(1);
end;

procedure TIfxSQL.InternalClose;
begin
  inherited;
  CountHolder(-1);
end;

procedure TIfxSQL.RegisterConnection;
begin
  inherited;
  RegisterConnectionClient(Self, ConnectionStateChange);
end;

procedure TIfxSQL.UnregisterConnection;
begin
  UnregisterConnectionClient(Self);
  inherited;
end;

procedure TIfxSQL.ConnectionChanging;
begin
  CheckClosed;
end;

procedure TIfxSQL.ConnectionClosing;
begin
  SetPrepared(False);
end;


end.